Clue dataset

users = read_feather(path = paste0(IO$output_clue, "users.feather"))

Population indicators

time_vec = seq(min(users$first_obs), max(users$last_obs), by = 1)
input_folder = paste0(IO$output_clue,"tracking/")
files = list.files(input_folder)

input_active_tracking = paste0(IO$tmp_clue,"active_tracking/")

tracking_pop_agg = foreach(file = files, .combine = rbind, .packages = c("dplyr","tidyverse")) %do% {
  # tracking
  tracking = read_feather(path = paste0(input_folder, file))
  tracking$BC = dict$BC$type[match(tracking$birth_control_ud, dict$BC$birth_control)]
  tracking =  filter(tracking, BC %in% c("F","I"))
  
  # variables aggregates
  tracking_pop_agg = ddply(tracking,
                           .(date,country_area,BC),
                           summarise,
                           n_prot_sex = sum((category == "sex") & (type == "protected_sex"), na.rm = TRUE),
                           n_unprot_sex = sum((category == "sex") & (type == "unprotected_sex"), na.rm = TRUE),
                           n_wd_sex = sum((category == "sex") & (type == "withdrawal_sex"), na.rm = TRUE)
  )
  
  tracking_pop_agg = tracking_pop_agg %>%  mutate(n_sex = n_prot_sex + n_unprot_sex + n_wd_sex)
  
  # active tracking
  active_tracking_compressed = read_feather(path = paste0(input_active_tracking,"active_",file))
  active_tracking = expand_compressed_tracking(active_tracking_compressed)
  active_tracking$BC = dict$BC$type[match(active_tracking$birth_control_ud, dict$BC$birth_control)]
  active_tracking =  filter(active_tracking, BC %in% c("F","I"))
  
  # total number of users
  active_tracking$country_area = tracking$country_area[match(active_tracking$user_id, tracking$user_id)]
  active_tracking_agg = ddply(active_tracking,
                              .(date,country_area,BC),
                              summarise,
                              n_users = sum(tracking, na.rm = TRUE)
  )
  
  
  
  tmp = dplyr::full_join(x = active_tracking_agg , y = tracking_pop_agg, by = c("date","country_area","BC")) %>%  
    arrange(country_area, BC, date) %>% 
    replace_na(list(n_prot_sex = 0,n_unprot_sex = 0, n_wd_sex= 0, n_sex = 0))
  
  return(tmp)
}

tmp = tracking_pop_agg %>% group_by(date, country_area, BC) %>% 
  summarise_each(.,sum) %>%  arrange(country_area, BC, date)
tracking_pop_agg = tmp


indicators_folder = paste0(IO$output_clue, "pop_indicators/")
if(!dir.exists(indicators_folder)){dir.create(indicators_folder)}
write_feather(tracking_pop_agg, path = paste0(indicators_folder, "sex_pop_indicators.feather"))
ggplot(tracking_pop_agg, aes(x = date, y = n_users, col = BC))+
  geom_line()+
  facet_wrap(country_area ~ .)

ggplot(tracking_pop_agg, aes(x = date, y = n_sex/n_users, col = BC))+
  geom_line()+
  facet_wrap(country_area ~ .)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), aes(x = date, y = n_sex/n_users, col = BC))+
  geom_line()+
  facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), aes(x = date, y = n_prot_sex/n_users, col = BC))+
  geom_line()+
  facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), aes(x = date, y = n_unprot_sex/n_users, col = BC))+
  geom_line()+
  facet_grid(country_area ~ BC)

tracking_pop_agg = tracking_pop_agg %>% mutate(weekday = wday(date, week_start = 1),
                                               month = month(date),
                                               date_month = year(date)+(month-1)/12)


ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), 
       aes(x = factor(weekday), y =  n_sex/n_users, col = BC))+
  geom_violin(draw_quantiles = c(0.25,0.5,0.75))+
  facet_grid(country_area ~ BC)
## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values

## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values

## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), 
       aes(x = factor(month), y =  n_sex/n_users, col = BC))+
  geom_violin(draw_quantiles = 0.5)+
  facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), 
       aes(x = factor(date_month), y =  n_sex/n_users, col = BC))+
  geom_violin(draw_quantiles = 0.5)+
  facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), 
       aes(x = date_month, y =  n_sex/n_users, col = BC, fill = BC))+
  stat_summary(geom="ribbon", 
               fun.ymin = function(x) quantile(x, 0.05), 
               fun.ymax = function(x) quantile(x, 0.95), 
               alpha = 0.3, col = NA) +   
  stat_summary(geom="ribbon", 
               fun.ymin = function(x) quantile(x, 0.25), 
               fun.ymax = function(x) quantile(x, 0.75), 
               alpha = 0.3, col = NA) +  
  stat_summary(geom = "line", fun.y=median) +
  facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>%  filter(date > as.Date("2017-06-30")), 
       aes(x = date_month, y =  n_sex/n_users, col = country_area))+
  stat_summary(geom = "line", fun.y=median) +
  facet_grid(. ~ BC)